home *** CD-ROM | disk | FTP | other *** search
/ Network Support Library / RoseWare - Network Support Library.iso / apidev / flagbi.arc / ENGINE.PAS next >
Pascal/Delphi Source File  |  1989-10-10  |  6KB  |  211 lines
  1. unit Engine;
  2. {******************************************************}
  3. {*   SEARCH ENGINE                                    *}
  4. {*    Input Parameters:                               *}
  5. {*      Mask : The file specification to search for   *}
  6. {*             May contain wildcards.                 *}
  7. {*      Attr : File attribute to search for           *}
  8. {*      Proc : Procedure to process each found file   *}
  9. {*                                                    *}
  10. {*    Output Parameters:                              *}
  11. {*      ErrorCode : Contains the final error code     *}
  12. {*                                                    *}
  13. {*This idea borrowed from Dr. Dobbs, Modified slightly*}
  14. {*By Azatar MicroSystems, Inc.                        *}
  15. {******************************************************}
  16.  
  17.  
  18. (*  All software is copyrighted by Azatar MicroSystems     *)
  19. (*  and Lee Drake.  Code for this example may be copied    *)
  20. (*  for non-commercial applications as long as this notice *)
  21. (*  is included in the header.  All commercial use is      *)
  22. (*  specifically excluded.                                 *)
  23.  
  24.  
  25. interface
  26.  
  27. uses
  28.    dos;
  29.  
  30. type
  31.    proctype    = procedure(var s : searchrec; p : pathstr);
  32.    proctype2   = procedure(var s : searchrec; p, origpath, np : pathstr);
  33.    fullnamestr = string[12];
  34.  
  35. procedure searchengine ( mask : pathstr;
  36.                          attr : byte;
  37.                          proc : proctype;
  38.                 var errorcode : byte);
  39.  
  40. procedure new_searchengine ( mask : pathstr;
  41.                              attr : byte;
  42.                              proc : proctype2;
  43.                              newp : pathstr;
  44.                     var errorcode : byte);
  45.  
  46. function gooddirectory (s : searchrec) : boolean;
  47.  
  48. procedure shrinkpath (var path : pathstr);
  49. Procedure SEARCHerrormessage (errcode : byte);
  50. procedure searchengineall ( path : pathstr;
  51.                             mask : fullnamestr;
  52.                             attr : byte;
  53.                             proc : proctype;
  54.                         var errorcode : byte);
  55.  
  56. implementation
  57.  
  58. var
  59.    enginemask  : fullnamestr;
  60.    engineattr  : byte;
  61.    engineproc  : proctype;
  62.    enginecode  : byte;
  63.  
  64. {*********************************************************}
  65. procedure searchengine ( mask : pathstr;
  66.                          attr : byte;
  67.                          proc : proctype;
  68.                 var errorcode : byte);
  69. var
  70.    s     : searchrec;
  71.    p     : pathstr;
  72.    ext   : extstr;
  73.  
  74. begin
  75.    {$V-}
  76.    fsplit(mask,p,mask,ext);
  77.    {$v+}
  78.    mask := mask + ext;
  79.    findfirst(p + mask, attr, s);
  80.    if doserror <> 0 then
  81.    begin
  82.       errorcode := doserror;
  83.       exit;
  84.    end;
  85.  
  86.    while doserror = 0 do
  87.    begin
  88.       proc(s,p);
  89.       findnext(s);
  90.    end;
  91.  
  92.    if doserror = 18 then
  93.       errorcode := 0
  94.    else
  95.       errorcode := doserror;
  96. end;   { of procedure }
  97.  
  98. {*********************************************************}
  99. procedure new_searchengine ( mask : pathstr;
  100.                              attr : byte;
  101.                              proc : proctype2;
  102.                              newp : pathstr;
  103.                     var errorcode : byte);
  104. var
  105.    s       : searchrec;
  106.    p       : pathstr;
  107.    ext     : extstr;
  108.    TEMPMSK : PATHSTR;
  109.  
  110. begin
  111.    TEMPMSK := MASK;
  112.    {$v-}
  113.    fsplit(mask,p,mask,ext);
  114.    {$v+}
  115.    mask := mask + ext;
  116.    findfirst(p + mask, attr, s);
  117.    if doserror <> 0 then
  118.    begin
  119.       errorcode := doserror;
  120.       exit;
  121.    end;
  122.  
  123.    while doserror = 0 do
  124.    begin
  125.       proc(s,p,TEMPmsk,newp);
  126.       findnext(s);
  127.    end;
  128.  
  129.    if doserror = 18 then
  130.       errorcode := 0
  131.    else
  132.       errorcode := doserror;
  133. end;   { of procedure }
  134.  
  135. {*********************************************************}
  136. function gooddirectory (s : searchrec) : boolean;
  137. begin
  138.    gooddirectory := (s.name <> '.')   and
  139.                     (s.name <> '..')  and
  140.                     (s.attr and directory = directory);
  141. end;
  142.  
  143. {*********************************************************}
  144. procedure shrinkpath (var path : pathstr);
  145. var
  146.    p     : byte;
  147.    dummy : namestr;
  148. begin
  149.    {$v-}
  150.    fsplit(path, path, dummy, dummy);
  151.    {$v+}
  152.    dec(path[0]);
  153. end;
  154.  
  155. {*********************************************************}
  156. {$f+} procedure searchonedir ( var s : searchrec; p : pathstr ); {$f-}
  157.       { recursive procedure to search one directory }
  158. begin
  159.    if gooddirectory(s) then
  160.    begin
  161.       p := p + s.name;
  162.       searchengine(p + '\' + enginemask, engineattr,
  163.                              engineproc, enginecode);
  164.       searchengine(p + '\*.*', directory or archive,
  165.                               searchonedir, enginecode);
  166.    end;
  167. end;
  168.  
  169. {*********************************************************}
  170. procedure searchengineall ( path : pathstr;
  171.                             mask : fullnamestr;
  172.                             attr : byte;
  173.                             proc : proctype;
  174.                         var errorcode : byte);
  175. begin
  176.    (* Set up unit global variables for use in
  177.        recursive directory search propcedure   *)
  178.    enginemask := mask;
  179.    engineproc := proc;
  180.    engineattr := attr;
  181.    searchengine(path + mask, attr, proc, errorcode);
  182.    searchengine(path + '*.*', directory or attr, searchonedir, errorcode);
  183.    errorcode := enginecode;
  184. end;
  185.  
  186. {*********************************************************}
  187. procedure SEARCHerrormessage (errcode : byte);
  188. begin
  189.    case errcode of
  190.     0 : ;   { ok - no error }
  191.     2 : writeln('file not found');
  192.     3 : writeln('path not found');
  193.     5 : writeln('access denied');
  194.     6 : writeln('invalid handle');
  195.     8 : writeln('not enough memory');
  196.    10 : writeln('invalid environment');
  197.    11 : writeln('invalid format');
  198.    18 : ;    { ok - merely no more files }
  199.   else
  200.      writeln('error #',errcode);
  201.    end;
  202. end;
  203.  
  204. begin
  205. end.
  206.  
  207.  
  208.  
  209.  
  210.  
  211.